home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / INDECZ.f < prev    next >
Text File  |  1992-07-31  |  2KB  |  68 lines
  1.       SUBROUTINE INDECZ(ISTR1,ISTR2)
  2. *-----------------------------------------------------------------------
  3. *   
  4. *  Checks consistency between replacement strings, kills illegal ones   
  5. *   
  6. *--- Input  
  7. *    ISTR1        ref. to string to be replaced (rel. to KKYSTA, KKYEND)
  8. *    ISTR2        ref. to replacing string  
  9. *-----------------------------------------------------------------------
  10.       include 'PARAM.h' 
  11.       include 'ALCAZA.h' 
  12.       include 'KEYCOM.h' 
  13.       include 'FLWORK.h' 
  14.       include 'CONDEC.h' 
  15.       DIMENSION ICT1(10),ICT2(10),IREF1(MXNAME/20,10), IREF2(MXNAME/20, 
  16.      +10)   
  17.       EQUIVALENCE (IREF1(1,1),IWS(1)),(IREF2(1,1),IWS(MXNAME/2+1))  
  18.       CHARACTER *40 STEXT(4)
  19.       DATA STEXT/'too many special symbols', 'unclosed [...] in string',
  20.      +'replacement count [n] too high', 
  21.      +'unclosed quote string inside string'/
  22.     
  23.       include 'CONDAT.h' 
  24.       IF(ISTR1.GT.0.AND.ISTR2.GT.0)  THEN   
  25. *--- extract special symbols from first string  
  26.          CALL SPECCT(1,ISTR1,NTOT1,ICT1,IREF1,IERR) 
  27.          IF (IERR.NE.0) GOTO 30 
  28. *--- second string  
  29.          CALL SPECCT(2,ISTR2,NTOT2,ICT2,IREF2,IERR) 
  30.          IF (IERR.NE.0) GOTO 30 
  31.          IF (NTOT2.GT.0)  THEN  
  32. *--- there are special symbols in the replacement string -  
  33. *    check that no count in [...] higher than actually present  
  34.             DO 20 I=1,LEN(SPCHAR)   
  35.                DO 10 J=1,ICT2(I)
  36.                   IF (ICT1(I).LT.IREF2(J,I))  THEN  
  37.                      IERR=3 
  38.                      GOTO 30
  39.                   ENDIF 
  40.    10          CONTINUE 
  41.    20       CONTINUE
  42.          ENDIF  
  43.       ENDIF 
  44.       GOTO 999  
  45.    30 CONTINUE  
  46. *--- error condition - suppress string (or name+string) replacement 
  47.       WRITE (MPUNIT,10000) STEXT(IERR)  
  48.       I1=KKYSTA(ISTR1)-1
  49.       I2=KKYEND(ISTR1)  
  50.       L=(I2-I1-1)/MXLINE+1  
  51.       DO 40 I=1,L   
  52.          SIMA(I)=SKYSTR(I1+1:MIN(I2,I1+MXLINE)) 
  53.          I1=I1+MXLINE   
  54.    40 CONTINUE  
  55.       CALL FLPRNT(0,'replace',L,SIMA,I1)
  56.       I1=KKYSTA(ISTR2)-1
  57.       I2=KKYEND(ISTR2)  
  58.       L=(I2-I1-1)/MXLINE+1  
  59.       DO 50 I=1,L   
  60.          SIMA(I)=SKYSTR(I1+1:MIN(I2,I1+MXLINE)) 
  61.          I1=I1+MXLINE   
  62.    50 CONTINUE  
  63.       CALL FLPRNT(0,'by string',L,SIMA,I1)  
  64.       ISTR1=-IERR   
  65. 10000 FORMAT(/' +++++++ WARNING - ',A,' in following replacement ', 
  66.      +'request, request ignored')   
  67.   999 END   
  68.